
module ProyectoIII(
	obtenerFrecuencia,
	crearRama,
	crearHuffman,
	generarAsociaciones,
	reconstruirHuffman,
	codificar,
	decodificar,
	Huffman (..)
)
where

import Fib
import Data.List

data Huffman a = Hoja Integer a | Rama Integer (Huffman a) (Huffman a) deriving (Show)


-- | Se establece cuando dos arboles de huffman son iguales y cuando son distintos
instance Eq (Huffman a) where
	(Hoja x _) == (Hoja y _) = (x == y)
	(Rama x _ _) == (Rama y _ _) = (x == y)
	(Hoja x _) == (Rama y _ _) = (x == y)

	(Hoja x _) /= (Hoja y _) = (x /= y)
	(Rama x _ _) /= (Rama y _ _) = (x /= y)
	(Hoja x _) /= (Rama y _ _) = (x /= y)

-- | Se hacen las operaciones de orden
instance Ord(Huffman a) where
	(Hoja x _) < (Hoja y _) = (x < y)
	(Hoja x _) < (Rama y _ _) = (x < y)
	(Rama x _ _) < (Rama y _ _) = (x < y)
	(Rama x _ _) < (Hoja y _) = (x < y)
	
	(Hoja x _) <= (Hoja y _) = (x <= y)
	(Hoja x _) <= (Rama y _ _) = (x <= y)
	(Rama x _ _) <= (Rama y _ _) = (x <= y)
	(Rama x _ _) <= (Hoja y _) = (x <= y)
	
	(Hoja x _) > (Hoja y _) = (x > y)
	(Hoja x _) > (Rama y _ _) = (x > y)
	(Rama x _ _) > (Rama y _ _) = (x > y)
	(Rama x _ _) > (Hoja y _) = (x > y)
	
	(Hoja x _) >= (Hoja y _) = (x >= y)
	(Hoja x _) >= (Rama y _ _) = (x >= y)
	(Rama x _ _) >= (Rama y _ _) = (x >= y)
	(Rama x _ _) >= (Hoja y _) = (x >= y)


-- | Obtiene la frecuencia acumulada que se encuentra en la raiz del Arbol de
--   Huffman suministrado.

obtenerFrecuencia :: (Ord a) => Huffman a -> Integer
obtenerFrecuencia (Hoja n a) = n 
obtenerFrecuencia (Rama n a1 a2) = n 

-- | A partir de dos Arboles de Huffman, crea un nuevo  ́arbol que los tiene
--   como hijos. La frecuencia acumulada del nuevo  ́arbol es la suma de la de
--   los nuevos hijos.

crearRama :: (Ord a) => Huffman a -> Huffman a -> Huffman a
crearRama (Hoja n a) (Hoja m b) = Rama (n+m) (Hoja n a) (Hoja m b)
crearRama (Hoja n a) (Rama m b1 b2) = Rama (n+m) (Hoja n a) (Rama m b1 b2)
crearRama (Rama n a1 a2) (Hoja m b) = Rama (n+m) (Rama n a1 a2) (Hoja m b)
crearRama (Rama n a1 a2) (Rama m b1 b2) = Rama (n+m) (Rama n a1 a2) (Rama m b1 b2)

-- | Dado una lista que contiene un conjunto de simbolos y su cantidad de
--   ocurrencias, construye un Arbol de Huffman que la represente.
crearHuffman :: (Ord a) => [(a, Integer)] -> Huffman a
crearHuffman l = findMin(crearHuffmanAux (fromList(transformar l)))
  where
  transformar :: (Ord a) => [(a, Integer)] -> [Huffman a]
  transformar l = [Hoja b a | (a,b) <- l]

  crearHuffmanAux :: (Ord a) => Fib.FibHeap (Huffman a) -> Fib.FibHeap (Huffman a)
  crearHuffmanAux h
    | (tamano h)  == 1 = h
    | otherwise = crearHuffmanAux (insertFib (deleteMin(deleteMin(h))) (crearRama (findMin(h))  (findMin(deleteMin(h)))))


-- | Dado un Arbol de Huffman, devuelve una lista de tuplas con el conjunto de
--   todos los simbolos ocurrentes en el arbol, junto a la codificacion binaria
--   de los mismos (La lista de booleanos representa la lista de bits de la
--   codificacion, donde False representa el cero y True el uno).
generarAsociaciones :: Huffman a -> [(a,[Bool])]
generarAsociaciones a = obtenerSimbolos a []  
  where
  obtenerSimbolos :: Huffman a -> [Bool] -> [(a,[Bool])]
  obtenerSimbolos (Hoja _ a) l = [(a,l ++ [True])] 
  obtenerSimbolos (Rama _ izq der) l = (obtenerSimbolos izq (l ++ [False])) ++ (obtenerSimbolos der (l ++ [True]))

-- | Dada una lista de tuplas con un conjunto de simbolos, junto a una codificacion 
--   binaria de los mismos construye un Arbol de Huffman tal que dichas asociaciones 
--   pudieran haber sido generadas. 
reconstruirHuffman :: (Ord a) => [(a, [Bool])] -> Huffman a
reconstruirHuffman l = reconstruirHuffmanAux (transformar l)
  where
  reconstruirHuffmanAux l
    | length(obtenerIzquierdo l) == 1 && length(obtenerDerecho l) > 1  = crearRama (fst(head(obtenerIzquierdo l))) (reconstruirHuffmanAux(obtenerDerecho l))
    | length(obtenerIzquierdo l)  > 1 && length(obtenerDerecho l) == 1 = crearRama (reconstruirHuffmanAux(obtenerIzquierdo l)) (fst(head(obtenerDerecho l)))
    | length(obtenerIzquierdo l) == 1 && length(obtenerDerecho l) == 1 = crearRama (fst(head(obtenerIzquierdo l))) (fst(head(obtenerDerecho l)))
    | length(obtenerIzquierdo l) >  1 && length(obtenerDerecho l) >  1 = crearRama (reconstruirHuffmanAux(obtenerIzquierdo l)) (reconstruirHuffmanAux(obtenerDerecho l))
    | length(l) == 1 = fst(head(l))

  obtenerDerecho :: [(a, [Bool])] -> [(a, [Bool])]
  obtenerDerecho l = [(x,ys) | (x,True:ys) <-l]

  obtenerIzquierdo :: [(a, [Bool])] -> [(a, [Bool])]
  obtenerIzquierdo l = [(x,ys) | (x,False:ys) <-l]

  transformar :: [(a,[Bool])] -> [(Huffman a,[Bool])]
  transformar l = [(Hoja 0 x, y) | (x,y) <- l ]

-- | Dado una lista de simbolos, devuelve una tupla. Esta tupla tiene como
--   primer elemento el Arbol de Huffman generado a partir de la lista de
--   simbolos dada. Como segundo elemento, tiene una lista donde cada uno
--   de los simbolos en la entrada, ha sido reemplazado por su representacion
--   binaria y concatenados para formar una sola cadena.
codificar :: (Ord a) => [a] -> (Huffman a, [Bool])
codificar cadena = (crearHuffman(cadenaApares cadena), covertir cadena (generarAsociaciones(crearHuffman(cadenaApares cadena))))

  where
  covertir :: (Ord a) => [a] -> [(a, [Bool])] -> [Bool]
  covertir [] _ = []
  covertir (x:xs) asoc = transformar(lookup x asoc) ++ (covertir xs asoc)

  transformar :: Maybe a -> a
  transformar (Just a) = a


-- | Transforma una cadena de caracteres a una lista de tuplas (elem, ocurrencia)
cadenaApares :: (Eq a) => [a] -> [(a, Integer)]
cadenaApares [] = []
cadenaApares lista = cadenaAparesAux (partition (== (head (lista))) lista)

cadenaAparesAux :: (Eq a) => ([a], [a]) -> [(a, Integer)]
cadenaAparesAux (a,b) = [(head(a),toInteger(length(a)))] ++ cadenaApares b


-- | Dado un Arbol de Huffman y luego una lista que representa a una cadena
--   de bits, devuelve una lista de simbolos que corresponde a la decodificacion
--   de dicha cadena con la informacion del arbol.
decodificar :: Huffman a -> [Bool] -> [a]
decodificar h l = recorrer h [] l 
  where
  recorrer :: Huffman a -> [a] -> [Bool] -> [a]
  recorrer _ listCaract [] = listCaract
  recorrer h listCaract resto  =  decodificarAux h resto listCaract h 

  decodificarAux :: Huffman a -> [Bool] -> [a] -> Huffman a -> [a]
  decodificarAux (Hoja _ a) [] l arbOrg = l
  decodificarAux (Hoja _ a) (True:xs) l arbOrg = recorrer arbOrg (l ++ [a]) xs

  decodificarAux (Rama _ izq der) (True:xs) l arbOrg = decodificarAux der xs l arbOrg
  decodificarAux (Rama _ izq der) (False:xs) l arbOrg = decodificarAux izq xs l arbOrg

